home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / button.tcl < prev    next >
Encoding:
Text File  |  1992-07-28  |  2.2 KB  |  71 lines
  1. # button.tcl --
  2. #
  3. # This file contains Tcl procedures used to manage Tk buttons.
  4. #
  5. # $Header: /user6/ouster/wish/scripts/RCS/button.tcl,v 1.7 92/07/28 15:41:13 ouster Exp $ SPRITE (Berkeley)
  6. #
  7. # Copyright 1992 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright
  11. # notice appears in all copies.  The University of California
  12. # makes no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without
  14. # express or implied warranty.
  15. #
  16.  
  17. # The procedure below is invoked when the mouse pointer enters a
  18. # button widget.  It records the button we're in and changes the
  19. # state of the button to active unless the button is disabled.
  20.  
  21. proc tk_butEnter w {
  22.     global tk_priv tk_strictMotif
  23.     if {[lindex [$w config -state] 4] != "disabled"} {
  24.     if {!$tk_strictMotif} {
  25.         $w config -state active
  26.     }
  27.     set tk_priv(window) $w
  28.     }
  29. }
  30.  
  31. # The procedure below is invoked when the mouse pointer leaves a
  32. # button widget.  It changes the state of the button back to
  33. # inactive.
  34.  
  35. proc tk_butLeave w {
  36.     global tk_priv tk_strictMotif
  37.     if {[lindex [$w config -state] 4] != "disabled"} {
  38.     if {!$tk_strictMotif} {
  39.         $w config -state normal
  40.     }
  41.     }
  42.     set tk_priv(window) ""
  43. }
  44.  
  45. # The procedure below is invoked when the mouse button is pressed in
  46. # a button/radiobutton/checkbutton widget.  It records information
  47. # (a) to indicate that the mouse is in the button, and
  48. # (b) to save the button's relief so it can be restored later.
  49.  
  50. proc tk_butDown w {
  51.     global tk_priv
  52.     set tk_priv(relief) [lindex [$w config -relief] 4]
  53.     if {[lindex [$w config -state] 4] != "disabled"} {
  54.     $w config -relief sunken
  55.     }
  56. }
  57.  
  58. # The procedure below is invoked when the mouse button is released
  59. # for a button/radiobutton/checkbutton widget.  It restores the
  60. # button's relief and invokes the command as long as the mouse
  61. # hasn't left the button.
  62.  
  63. proc tk_butUp w {
  64.     global tk_priv
  65.     $w config -relief $tk_priv(relief)
  66.     if {($w == $tk_priv(window))
  67.         && ([lindex [$w config -state] 4] != "disabled")} {
  68.     uplevel #0 [list $w invoke]
  69.     }
  70. }
  71.